home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / 3D_TMAP1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  2.1 KB  |  62 lines
  1.  
  2. program texturemapping; { 3D_TMAP1.PAS }
  3. { Gouraud Shading, by Jeroen Bouwens }
  4. uses u_vga,u_pal,u_3d,u_kb;
  5. const
  6.   nofpoints=8; { cube has 8 corners }
  7.   nofplanes=12; { 2 triangles/face, 6 faces = 12 triangles }
  8.   points:array[1..nofpoints,0..2] of integer=(
  9.     (10,10,10),(-10,10,10),(-10,-10,10),(10,-10,10),
  10.     (10,10,-10),(-10,10,-10),(-10,-10,-10),(10,-10,-10));
  11.   planes:array[1..nofplanes,0..2] of integer=(
  12.     (1,2,6),(1,6,5),(2,3,7),(2,7,6),(3,4,8),(3,8,7),
  13.     (4,1,5),(4,5,8),(3,2,1),(3,1,4),(5,6,7),(5,7,8));
  14.  
  15. procedure rotate_object;
  16. const
  17.   depth=400;
  18.   xst=1; yst=2; zst=-3;
  19. var
  20.   xa,ya,za:array[1..nofpoints] of real; { rotated object coords }
  21.   bx,by,bz:array[1..nofpoints] of integer; { 2d coords }
  22.   virscr:pointer;
  23.   xt,yt,zt:real;
  24.   phix,phiy,phiz,                                 { angles of rotated object }
  25.   i,j:byte;
  26. begin
  27.   phix:=0; phiy:=0; phiz:=0;
  28.   getmem(virscr,320*200); { reserve memory for virtual screen }
  29.   destenation:=virscr; destseg:=seg(destenation^); { set new destenation }
  30.   repeat
  31.     for i:=1 to nofpoints do begin
  32.       xt:=points[i,0]; yt:=points[i,1]; zt:=points[i,2]; { get original }
  33.       rrotate(xt,yt,zt,phix,phiy,phiz); { rotate it }
  34.       bz[i]:=15+round(zt/1.2);
  35.       zt:=zt+60;
  36.       xa[i]:=xt; ya[i]:=yt; za[i]:=zt-20;
  37.       bx[i]:=160+round((xt*depth)/zt); { convert to 2d }
  38.       by[i]:=100+round((yt*depth*0.8333)/zt);
  39.     end;
  40.     cls(virscr,320*200);
  41.     for i:=1 to nofplanes do
  42.       if not checkfront(bx[planes[i,0]],by[planes[i,0]],
  43.           bx[planes[i,1]],by[planes[i,1]],
  44.           bx[planes[i,2]],by[planes[i,2]]) then begin
  45.         gouraud(bx[planes[i,0]],by[planes[i,0]],bz[planes[i,0]],
  46.           bx[planes[i,1]],by[planes[i,1]],bz[planes[i,1]],
  47.           bx[planes[i,2]],by[planes[i,2]],bz[planes[i,2]]);
  48.       end;
  49.     flip(virscr,vidptr,320*200); { display picture }
  50.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst); { increase angles }
  51.   until keypressed;
  52.   freemem(virscr,320*200);
  53. end;
  54.  
  55. var i:byte;
  56. begin
  57.   setvideo($13);
  58.   for i:=1 to 31 do setrgb(i,8-i shr 2,16-i shr 1,32-i);
  59.   rotate_object;
  60.   setvideo(u_lm);
  61. end.
  62.